unit ArpUnit;

interface

uses
  SysUtils,
  Classes,
  Windows,
  IpHlpApi,
  IpRtrMib,
  IpTypes,
  IpIfConst,
  WinSock;


type
  TPhysAddrByteArray = array [0..MAXLEN_PHYSADDR - 1] of BYTE;



  function GetIntfIndex: string;
  procedure StringToPhysAddr(PhysAddrString: string; var PhysAddr: TPhysAddrByteArray);
  procedure SetArpEntry(const InetAddr, EtherAddr, IntfAddr: string);
  function GetGatewayIps: string;

implementation

uses ConstUnit;

function GetIntfIndex: string;
var
  Adapters, Adapter: PIPAdapterInfo;
  dwResult, Size: DWORD;
  i: Integer;
begin
  Size := 0;
  if GetAdaptersInfo(nil, Size) <> ERROR_BUFFER_OVERFLOW then Exit;
  Adapters := AllocMem(Size);
  try
    if GetAdaptersInfo(Adapters, Size) = NO_ERROR then
    begin
      Adapter := Adapters;
      while Adapter <> nil do
      begin
//        IpAddrString := @Adapter^.IpAddressList;
//        while IpAddrString <> nil do
//        begin
////          if CompareText(IpAddrString^.IpAddress.S, Intf) = 0 then
////          begin
////            Result := Adapter^.Index;
////            Exit;
////          end;
//          IpAddrString := IpAddrString^.Next;
//        end;
//        Adapter^.GatewayList.IpAddress
        Result := Result + Format('%d,', [Adapter^.Index]);
        Adapter := Adapter^.Next;
      end;
    end;
  finally
    FreeMem(Adapters);
  end;

  if Result <> '' then
    Result := Copy( Result, 1, Length(Result) - 1 );
end;

function CharHex(const C: AnsiChar): Byte;
const
  AnsiDecDigits = ['0'..'9'];
  AnsiHexDigits = ['0'..'9', 'A'..'F', 'a'..'f'];
begin
  Result := $FF;
  if C in AnsiDecDigits then
    Result := Ord(C) - 48
  else if C in AnsiHexDigits then
    Result := Ord(C) - 55;
end;

procedure StringToPhysAddr(PhysAddrString: string; var PhysAddr: TPhysAddrByteArray);
var
  C: Char;
  I, V: Integer;
begin
  Assert(Length(PhysAddrString) = 17);
  Assert(
    (PhysAddrString[3] = MacSep) and
    (PhysAddrString[6] = MacSep) and
    (PhysAddrString[9] = MacSep) and
    (PhysAddrString[12] = MacSep) and
    (PhysAddrString[15] = MacSep));
  PhysAddrString := UpperCase(PhysAddrString);
  for I := 0 to 5 do
  begin
    C := PhysAddrString[I * 3 + 1];
    V := CharHex(C) shl 4;
    C := PhysAddrString[(I * 3) + 2];
    V := V + CharHex(C);
    PhysAddr[I] := V;
  end;
end;

function StringToIpAddr(const Addr: string): DWORD;
begin
  Result := inet_addr(PChar(Addr));
end;

function GetIpAddrTableWithAlloc: PMibIpAddrTable;
var
  Size: ULONG;
begin
  Size := 0;
  GetIpAddrTable(nil, Size, True);
  Result := AllocMem(Size);
  if GetIpAddrTable(Result, Size, True) <> NO_ERROR then
  begin
    FreeMem(Result);
    Result := nil;
  end;
end;

function FirstNetworkAdapter(IpAddrTable: PMibIpAddrTable): Integer;
var
  I: Integer;
  IfInfo: TMibIfRow;
begin
  // TODO this is a "stupid" implementation, can be done much easier by using
  // enumerating the interface table directly
  Result := -1;
  for I := 0 to IpAddrTable^.dwNumEntries - 1 do
  begin
    {$R-}IfInfo.dwIndex := IpAddrTable^.table[I].dwIndex;{$R+}
    if GetIfEntry(@IfInfo) = NO_ERROR then
    begin
      if IfInfo.dwType in [MIB_IF_TYPE_ETHERNET, MIB_IF_TYPE_TOKENRING] then
      begin
        Result := IfInfo.dwIndex;
        Break;
      end;
    end;
  end;
end;

procedure SetArpEntry(const InetAddr, EtherAddr, IntfAddr: string);
var
  Entry: TMibIpNetRow;
  IpAddrTable: PMibIpAddrTable;
begin
  FillChar(Entry, SizeOf(Entry), 0);
  Entry.dwAddr := StringToIpAddr(InetAddr);
  Assert(Entry.dwAddr <> DWORD(INADDR_NONE));
  Entry.dwPhysAddrLen := 6;
  StringToPhysAddr(EtherAddr, TPhysAddrByteArray(Entry.bPhysAddr));
  Entry.dwType := MIB_IPNET_TYPE_STATIC;
  if IntfAddr <> '' then
    Entry.dwIndex := StrToInt(IntfAddr)
  else
  begin
    IpAddrTable := GetIpAddrTableWithAlloc;
    Assert(IpAddrTable <> nil);
    Entry.dwIndex := FirstNetworkAdapter(IpAddrTable);
    FreeMem(IpAddrTable);
  end;
//  WriteLn(SysErrorMessage(SetIpNetEntry(Entry)));
  SetIpNetEntry(Entry);
end;

function GetGatewayIps: string;
var
  Adapters, Adapter: PIPAdapterInfo;
  dwResult, Size: DWORD;
  i: Integer;
begin
  Size := 0;
  if GetAdaptersInfo(nil, Size) <> ERROR_BUFFER_OVERFLOW then Exit;
  Adapters := AllocMem(Size);
  try
    if GetAdaptersInfo(Adapters, Size) = NO_ERROR then
    begin
      Adapter := Adapters;
      while Adapter <> nil do
      begin
//        IpAddrString := @Adapter^.IpAddressList;
//        while IpAddrString <> nil do
//        begin
////          if CompareText(IpAddrString^.IpAddress.S, Intf) = 0 then
////          begin
////            Result := Adapter^.Index;
////            Exit;
////          end;
//          IpAddrString := IpAddrString^.Next;
//        end;
//        Adapter^.GatewayList.IpAddress
        if Adapter^.GatewayList.IpAddress.S <> '' then
          Result := Result + Format('%s,', [Adapter^.GatewayList.IpAddress.S]);
        Adapter := Adapter^.Next;
      end;
    end;
  finally
    FreeMem(Adapters);
  end;

  if Result <> '' then
    Result := Copy( Result, 1, Length(Result) - 1 );
end;

end.
